Developer CD Series 1996 May: Tool Chest/Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso/Sample Code/Snippets/Printing/HairLines/HairLines.p

Text File | 1992-07-15 | 18.0 KB | 669 lines | [TEXT/MPS ]

{**
 **     Program: HairLines
 **
 **     Version: 1.03    6/16/91
 **
 **     Purpose:
 **
 **        HairLines demonstrates the proper way to draw hairlines on both
 **        PostScript and QuickDraw printers.
 **
 **        Dave Hersey
 **
 **        Macintosh Developer Technical Support
 **
 **        ------
 **        v1.0    - 4/28/91, DMH
 **                - First attempt.
 **
 **        v1.01    - 5/6/91, DMH
 **                - Added missing DisposHandle call for widHdl in DrawStuff.
 **                  Fixed scaling problems so that all methods scale alike.
 **                  Added 'vers' and 'SIZE' resources.
 **                  Adjusted SetLineWidth scale values so that true hairlines are created.
 **
 **        v1.02    - 5/9/91, DMH
 **                - Revised comments about SetLineWidth.  The minimum value is
 **                  1/128, not 1/28.
 **                - Fixed the drawing routine so that it doesn't box rectangles that
 **                  have collapsed on themselves.  There were logic bugs.
 **
 **        v1.03    - 6/16/91, DMH
 **                - Revised comments throughout source code.  No actual code changes.
 **
 **}

PROGRAM HairLines;

USES
    MemTypes, QuickDraw, OSIntf, ToolIntf, Traps, MacPrint, Packages, PrintComments;

CONST

    {The following constants are used to identify menus and their items. The menu IDs
     have an "m" prefix and the item numbers within each menu have an "i" prefix.}

    rMenuBar    = 128;                    {menubar}

    mApple        = 128;                    {Apple menu}
    iAbout        = 1;

    mFile        = 129;                    {File menu}
    iPrint        = 1;
    iQuit        = 3;

    mEdit        = 130;                    {Edit menu}

    mSettings    = 131;                    {Settings menu}
    iuseSetLine    = 1;
    iusePrGen    = 2;
    iuseScale    = 3;


VAR

    gQuitting    : Boolean;                {"Are we all done?" flag}


{*------ DrawStuff -----------------------------------------------------------------*}

{**
 **      DrawStuff draws the objects.  If doSetLineWidth is true, we make SetLineWidth
 **        PicComment calls.  The doPrGeneral flag is just passed in for the text output.
 **        prRsl is the resolution of the printer's GrafPort and is used to determine
 **        the amount to scale everything.
 **}

{$S Main}
 PROCEDURE DrawStuff(theWorld : Rect; theGPort : GrafPtr; doPrGeneral, doSetLineWidth, doScale: Boolean; prRsl : Integer);

 VAR
    oldPort        : GrafPtr;
    Width        : Widhdl;
    aRect        : Rect;
    count        : Integer;
    scaleFactor    : Comp;
    fNum        : Integer;
    numStr        : Str255;
    hInc, vInc    : Integer;
    temp        : Integer;

 BEGIN

{Get the current port and save it.  Set the port to our drawing GrafPort and clip
 it to the world's bounds.  Finally, make sure we're using normal pen settings.}

    GetPort(oldPort);
    SetPort(theGPort);
    ClipRect(theWorld);
    PenNormal;


{If we're supposed to be using the SetLineWidth PicComment, then use it.  The
 pen size is already set to (1, 1) by the PenNormal call above.  When this prints
 it will be treated as a 4 pixel pen size.  By passing a pen size scalar with the
 SetLineWidth PicComment, we can make this smaller.  The smallest scalar that
 SetLineWidth recognizes is 1/128th.  Anything smaller may cause problems.  In
 practice, values from 1/26 to 1/128 yield the same results.  The SetLineWidth
 PicComment is currently only supported by Postscript printer drivers, and is
 explained in Tech Note #91.}

    Width := widhdl(NewHandle(sizeof(widpt)));

    Width^^.h := 28;                {denominator.  1/128th is max. value of scalar,
                                      but 1/28 yields the same results on a standard
                                     LaserWriter.}

    Width^^.v := Round(prRsl/72);    {numerator.  If we're not at 72 dpi, we need
                                     to adjust the penSize scalar for the printer's
                                     coordinate system.}

    IF (doSetLineWidth) THEN PicComment(SetLineWidth, 4, Handle(width));


{We need to make sure that our graphics are scaled correctly for the printer's
 resolution.  They were created at 72 dpi, (the standard), and need to be scaled
 based on the printer port's resolution.  The port defaults to 72 dpi,
 but we may have used PrGeneral to increase this resolution.  If we passed
 a FALSE doScale value to this routine, no scaling will be done.  This shows
 the effect of using PrGeneral to set the printer to a higher resolution
 without scaling.  Normally, you wouldn't want to do this.  It's just here for
 demonstration purposes.}

    IF doScale THEN
        scaleFactor := prRsl/72.0
    ELSE
        scaleFactor := 1.0;


{Set aRect to the area we'll draw in.  In this case, it's the entire page.
 Next, move the pen to the bottom of the page and set the Times font.
 Notice that we need to scale the font size just as we would any other
 graphic when using a non-72 dpi printer port.  If we don't, things will
 be scaled wrong.}

    aRect := theWorld;

    MoveTo(aRect.left +Round(5 * scaleFactor), aRect.bottom -Round(10 * scaleFactor));
    GetFNum('Times', fnum);
    TextFont(fNum);
    TextSize(Round(12 * scaleFactor));


{Draw a string that explains the graphic being printed.  If non-hairlined
 objects are being printed, we just say that.  Otherwise, we give other
 vitals such as what methods were used and the resolution the test pattern
 was printed at.}

    IF (NOT doPrGeneral AND NOT doSetLineWidth) THEN
        DrawString('An example of non-hairlined objects.')
    ELSE
    BEGIN

        DrawString('An example of hairlined objects printed at ');

        NumToString(prRsl, numStr);
        DrawString(numStr);
        DrawString(' dpi ');

        IF (NOT doSetLineWidth) THEN DrawString('w/o ');

        DrawString('using the SetLineWidth PicComment, ');

        IF (NOT doPrGeneral) THEN DrawString('w/o ');

        DrawString('using PrGeneral.');

    END;


{Draw a string saying we didn't scale if we didn't and we should have.
 This way, the user knows why the page looks funny.  We scale our font
 size here, no matter what doScale says.  Otherwise they won't be able
 to read the message.  Also bop the top of the drawing area down a bit
 so we won't draw over our message.}

    IF (NOT doScale AND doPrGeneral) THEN
    BEGIN

        MoveTo(5 * Round(prRsl/72), 20 * Round(prRsl/72));
        TextSize(12 * Round(prRsl/72));
        DrawString('Graphics not appropriately scaled for PrGeneral.');
        aRect.top := aRect.top + 30 * Round(prRsl/72);

    END;


{Now we actually draw the objects.  This is just a bunch of lines, rectangles
 and ovals that make a quasi-neat pattern.  We move the bottom of the drawable
 up a tad so that we don't draw over our text.  hInc and vInc are the increments
 to move in after drawing each set of objects.}

    aRect.bottom := aRect.bottom -Round(30 * scaleFactor);

    hInc := 10;
    vInc := 15;

    FOR count := 1 TO 35 DO
    BEGIN

{The check below tells us if the left and right of aRect have crossed for
 the first time.  If so, we change our increments to expand the graphics
 back outward.}

        IF (aRect.left > aRect.right) OR (aRect.top > aRect.bottom) THEN
        BEGIN

            IF (aRect.top > aRect.bottom) THEN
            BEGIN

                temp := aRect.top;
                aRect.top := aRect.bottom;
                aRect.bottom := temp;
                hInc := 5;
                vInc := -9;

            END;

            IF (aRect.left > aRect.right) THEN
            BEGIN

                temp := aRect.left;
                aRect.left := aRect.right;
                aRect.right := temp;
                hInc := -5;
                vInc := 9;

            END;
        END;


{Draw the objects.  When done, dispose of our width handle and restore the old
 graphics port.}

        InsetRect(aRect, Round(scaleFactor * hInc), Round(scaleFactor * vInc));


{Draw a rectangle and an oval, but only do this if our rectangle hasn't been
 inset so much that its sides have collapsed.  Otherwise, what QuickDraw and
 a particular driver do will be unpredictable.}

        IF (hInc > 0) AND (vInc > 0) THEN
        BEGIN

            FrameRect(aRect);
            FrameOval(aRect);

        END;

        MoveTo(aRect.left +1, aRect.top +1);
        LineTo(aRect.right -1, aRect.bottom -1);
        MoveTo(aRect.left +1, aRect.bottom -1);
        LineTo(aRect.right -1, aRect.top +1);

    END;

    IF (Width <> nil) THEN DisposHandle(Handle(Width));
    SetPort(oldPort);

 END;    {**  DrawStuff  **}


{*------ GetBestRsl -----------------------------------------------------------------*}

{**
 **      GetBestRsl determines the best "square" resolution supported by the printer.
 **        For example, 300 dpi horizontal by 300 dpi vertical.  It isn't necessary to
 **        use square resolutions, but it generally proves easier.  We use PrGeneral and
 **        the getRslDataOp opCode to get a list of the supported resolutions for our
 **        printer.  Then we just go through the rgRslRec and find the maximum square
 **        resolution for discrete or non-discrete data, whichever we have.  Finally, we
 **        make sure it's divisible by 72 for cleaner scaling.
 **}

{$S Main}
FUNCTION GetBestRsl :Integer;

VAR
        err            : OSErr;
        theRes, num    : Integer;
        getRslData    : TGetRslBlk;

BEGIN

{Start off with our maximum resolution at 0, then call PrGeneral and parse our list
 of returned values.}

        theRes := 0;
        getRslData.iOpCode := getRslDataOp;

        PrGeneral(@getRslData);
        err := getRslData.iError;

{If our printer only supports discrete resolutions, find the largest square one and
 use that.  If our printer supports a range of resolutions, choose the smaller of the
 maximum X and Y resolutions, then make it divisible by 72 for cleaner scaling.}

        IF (err = noErr) THEN
            IF (getRslData.XRslRg.iMax = 0) AND (getRslData.YRslRg.iMax = 0) THEN
                BEGIN                                                                {Discrete resolutions.}
                    FOR num := 1 TO getRslData.iRslRecCnt DO
                        IF (getRslData.rgRslRec[num].iXRsl = getRslData.rgRslRec[num].iYRsl)
                            AND (theRes < getRslData.rgRslRec[num].iXRsl) THEN
                                theRes := getRslData.rgRslRec[num].iXRsl;
                END
            ELSE
                BEGIN                                                                {Variable resolutions.}
                    IF (getRslData.XRslRg.iMax < getRslData.YRslRg.iMax) THEN
                        theRes := (getRslData.XRslRg.iMax DIV 72) * 72            {Use multiple of 72 closest to max. X resolution.}
                    ELSE
                        theRes := (getRslData.YRslRg.iMax DIV 72) * 72            {Use multiple of 72 closest to max. Y resolution.}
                END;


{In the unlikely event that PrGeneral fails and theRes is still 0, set it to 72.
 This most likely is a supported resolution.  Finally return the best resolution we
 could find.}

        IF theRes = 0 THEN theRes := 72;
        GetBestRsl := theRes;

END;    {**  GetBestRsl  **}


{*------ PrintStuff ----------------------------------------------------------------*}
{**
 **        PrintStuff will call all of the necessary Print Manager calls to print
 **        a document. It checks PrError after each Print Manager call. If an error
 **     is found, all of the Print Manager open calls (i.e. PrOpen, PrOpenDoc...)
 **        will have a corresponding close call before the error is posted to the user.
 **        You want to use this approach to make sure the Print Manager closes properly
 **        and all temporary memory is released.
 **}

{$S Main}
PROCEDURE PrintStuff;

VAR
    Loop,
    NumberOfPages,
    PageNumber        : Integer;
    PrintError        : LongInt;
    oldPort          : GrafPtr;
    thePrRecHdl        : THPrint;
    thePrPort        : TPPrPort;
    theStatus        : TPrStatus;
    errStr            : Str255;
    rslData            : TSetRslBlk;
    err                : OSErr;
    prRsl            : Integer;
    doPrGeneral        : Boolean;
    hasPScript        : Boolean;
    doSetLineWidth    : Boolean;
    doScale            : Boolean;
    setMHdl            : MenuHandle;
    mark            : Char;
    bestRsl            : Integer;

BEGIN

{Get our settings from the Settings menu and set up our Booleans appropriately.}

    setMHdl := GetMHandle(mSettings);
    GetItemMark(setMHdl, iuseSetLine, mark);
    doSetLineWidth := (mark <> Char(noMark));
    GetItemMark(setMHdl, iusePrGen, mark);
    doPrGeneral := (mark <> Char(noMark));
    GetItemMark(setMHdl, iuseScale, mark);
    doScale := (mark <> Char(noMark));


{Get our current port and create a print handle.  If no errors,
 do our PrOpen call and, if no errors again, get the default
 settings for the current driver.}

    GetPort(oldPort);
    thePrRecHdl := THPrint(NewHandle(sizeof(TPrint)));

    IF (MemError = noErr) THEN
    BEGIN
        PrOpen;
        IF (PrError = noErr) THEN
        BEGIN
            PrintDefault(thePrRecHdl);


{At this point we can check for PostScript drivers.  If the
 high byte of the prStl dialog's wDev field is 3, we're using an Apple
 PostScript driver.  Most third party drivers use this notation as well.
 DTS does not recommend using this method unless you absolutely need to,
 although it is a low-risk compatibility problem.  In other words, it's
 the only way to check for PostScript now, but some day it will no
 longer work.}

            hasPScript := BAND(thePrRecHdl^^.prStl.wDev, $0300) = $0300;


{If this printer driver does not support PostScript, clear our SetLineWidth
 flag.  This PicComment is currently only supported with PostScript drivers.}

            IF (NOT hasPScript) THEN
                doSetLineWidth := FALSE;


{Set prRsl to 72 in case we aren't using PrGeneral or we get an error
 when setting the best resolution.  If we are using PrGeneral, get the
 best "square" resolution and set the printer to that.  If we have a
 problem, we'll use a resolution of 72 dpi, which is the default for
 most Macintosh printers.}

            prRsl := 72;

            IF (doPrGeneral) THEN
            BEGIN

                bestRsl := GetBestRsl;
                rslData.iOpCode := SetRslOp;
                rslData.hPrint := thePrRecHdl;
                rslData.iXRsl := bestRsl;
                rslData.iYRsl := bestRsl;
                PrGeneral(@rslData);
                err := rslData.iError;

                IF (err = noErr) THEN prRsl := bestRsl;

            END;


{If we still have no errors, give style and print job dialogs, then open a
 document and its page.  Keep checking for those dang printer errors.}

            IF (PrError = noErr) THEN
            BEGIN
                IF (PrStlDialog(thePrRecHdl)) THEN
                BEGIN
                    IF (PrJobDialog(thePrRecHdl)) THEN
                    BEGIN
                        thePrPort := PrOpenDoc(thePrRecHdl, NIL, NIL);

                        IF (PrError = noErr) THEN
                        BEGIN
                            PrOpenPage(thePrPort, NIL);


{If we're still running error-free, draw our test page.  rPage is the
 printed page's dimensions, thePrPort is the printer port we're drawing
 into, doPrGeneral, doSetLineWidth and doScale are flags relating to our
 printing methods and prRsl is the resolution of our printer port.}

                            IF (PrError = noErr) THEN
                                DrawStuff(thePrRecHdl^^.prInfo.rPage,
                                          GrafPtr(thePrPort),
                                          doPrGeneral, doSetLineWidth, doScale, prRsl);


{When done, close our page and document and spool the document if necessary.  When
 finshed, call PrClose to end the whole shabang.}

                            PrClosePage(thePrPort);
                        END;

                        PrCloseDoc(thePrPort);

                        IF (thePrRecHdl^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) THEN
                            PrPicFile(thePrRecHdl, NIL, NIL, NIL, theStatus);
                    END;
                END;
            END;
        END;

        PrClose;

    END;

END;    {**  PrintStuff  **}


{*------ Initialize ----------------------------------------------------------------*}
{**
 **        Initialize just handles necessary Toolbox initializing, setting our quitting
 **        flag to FALSE and installing our menus.
 **}

{$S Initialize}
PROCEDURE Initialize;

VAR
    menuBar    : Handle;

BEGIN

    InitGraf(@thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;
    FlushEvents(everyEvent, 0);

    gQuitting := FALSE;

    menuBar := GetNewMBar(rMenuBar);        {read menus into menu bar}
    IF (menuBar = NIL) THEN ExitToShell;    {should do real error stuff here.}
    SetMenuBar(menuBar);                    {install menus}
    DisposHandle(menuBar);
    AddResMenu(GetMHandle(mApple), 'DRVR');    {add DA names to Apple menu}
    DrawMenuBar;

END;    {**  Initialize  **}


{$S _DataInit}
PROCEDURE _DataInit; EXTERNAL;

{This routine is automatically linked in by the MPW Linker. This external
 reference to it is done so that we can unload its segment, %A5Init.}



{*------ ToggleCMark ----------------------------------------------------------------*}
{**
 **        ToggleCMark is called when an item in the Settings menu is chosen.
 **        It simply toggles the checkmark next to the item passed.
 **}

{$S Main}
PROCEDURE ToggleCMark(menuItem: Integer);

VAR
    setMHdl        : MenuHandle;
    mark        : Char;

BEGIN

    setMHdl := GetMHandle(mSettings);
    GetItemMark(setMHdl, menuItem, mark);
    CheckItem(setMHdl, menuItem, (mark = Char(noMark)));

END;    {**  ToggleCMark  **}


{*------ DoMenuCommand ----------------------------------------------------------------*}
{**
 **        DoMenuCommand is called when an item is chosen from the menu bar (after calling
 **        MenuSelect or MenuKey).  It does the right thing for each command.
 **}

{$S Main}
PROCEDURE DoMenuCommand(menuResult: LONGINT);

VAR
    menuID, menuItem    : INTEGER;
    daRefNum            : INTEGER;
    daName                : Str255;

BEGIN

{Get the menu ID and item ID.}

    menuID := HiWrd(menuResult);
    menuItem := LoWrd(menuResult);

    CASE menuID OF
        mApple:
            CASE menuItem OF
                iAbout:                {bring up alert for About}
                    (* We do nothing here... *);

                OTHERWISE
                BEGIN        {all non-About items in this menu are DAs}
                    GetItem(GetMHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
            END;

        mFile:                            {File Menu}
            CASE menuItem OF
                iPrint:                        {-> Print Test Page.}
                    PrintStuff;
                iQuit:
                    gQuitting := TRUE;        {-> Quit}
            END;

        mSettings:                        {Settings menu}
            ToggleCMark(menuItem);            {-> Toggle checkmark for item.}
    END;
    HiliteMenu(0);

END;    {**  DoMenuCommand  **}


{*------ DoEvent ----------------------------------------------------------------*}
{**
 **        DoEvent handles incoming events for our app.  In this skimpy sample, we
 **        only handle menu events and system clicks.
 **}

{$S Main}
PROCEDURE DoEvent;

VAR
    part        : INTEGER;
    key            : Char;
    quitting    : Boolean;
    event        : EventRecord;
    window        : WindowPtr;

BEGIN

{Repeatedly handle menu selecting events until our quit flag is set.}

    REPEAT
        BEGIN
            SystemTask;                                    {This must be called if using GetNextEvent}

            IF (GetNextEvent(everyEvent, event)) THEN
                CASE event.what OF
                    mouseDown:
                        BEGIN
                            part := FindWindow(event.where, window);
                            CASE part OF
                                inMenuBar:
                                    DoMenuCommand(MenuSelect(event.where));

                                inSysWindow:
                                    SystemClick(event, window);
                            END;
                        END;

                    keyDown, autoKey:
                        BEGIN
                            key := CHR(BAnd(event.message, charCodeMask));
                            IF (BAnd(event.modifiers, cmdKey) <> 0) AND (event.what = keyDown) THEN
                                DoMenuCommand(MenuKey(key));
                        END;
                END;
        END;
    UNTIL gQuitting;

END;    {**  DoEvent  **}


{*------ Main ----------------------------------------------------------------*}
{**
 **        Main kickstarts our app.
 **}

{$S Main}
BEGIN

    UnloadSeg(@_DataInit);    {note that _DataInit must not be in Main!}
    MaxApplZone;            {expand the heap so code segments load at the top}
    Initialize;                {initialize the program}
    UnloadSeg(@Initialize);    {note that Initialize must not be in Main!}
    DoEvent;                {handle menu events until quitting.}

END.    {**  HairLines.  **}